EnigmA Amiga Run 1998 July/EnigmA AMIGA RUN 29 (1998)(G.R. Edizioni)(IT)[!][issue 1998-07 & 08].iso/earkit/news/thor/rexx/keepmsg.thor

Text File | 1998-05-24 | 5KB | 166 lines

/*
** $VER: KeepMsg.thor 1.4 (4.9.97)
** by Eirik Nicolai Synnes <[e-mail]>
**
** Copies the current or selected message to a special "Keep" conference and
** sets the KEEP flag on them.
**
** Specify the conference name in the toconf string below. If the conference
** doesn't exist it will be created.
**
** If you don't want the copy in the destination conference to be marked as
** unread make sure nomarkmsg is set to 1 below. Otherwise set it to 0.
**
** Fixed in 1.3c:
** o Added support for "real kills"
**
** Fixed in 1.4:
** o Version string is compliant to the C= guidelines
**
*/

toconf  = 'The Keep'
nomarkmsg = 0

options results
options failat 30

signal on syntax
signal on halt
signal on break_c

CDF_NOT_ON_BBS   = '00008000'x  /* This conference is not on the bbs. */

/* Open Thor and BBSREAD ARexx ports' */

p=' '||address()||' '||show('P',,)
if pos(' THOR.',p)>0 then thorport=word(substr(p,pos(' THOR.',p)+1),1)
else do
    say 'No THOR port found!'
    exit(0)
    end

if ~show('p', 'BBSREAD') then do
    address command; "run >nil: `GetEnv THOR/THORPath`bin/LoadBBSRead"
    "WaitForPort BBSREAD"
    if rc ~= 0 then do
        address(thorport)
        REQUESTNOTIFY '"Couldn''t open BBSRead''s ARexx port."' '"I see"'
        exit(0)
        end
    end

address(thorport)
trace off; CURRENTMSG curmsg; trace on
if rc ~= 0 then do
    REQUESTNOTIFY '"CURRENTMSG:\n'THOR.LASTERROR'"' '"Abort"'
    exit(0)
    end

GETMSGLISTSELECTED msgsel
if rc = 3 | rc = 5 then do
    msgsel.1 = curmsg.MSGNR; msgsel.COUNT = 1
    end
else if rc ~= 0 then do
    REQUESTNOTIFY '"GETMSGLISTSELECTED:\n'THOR.LASTERROR'"' '"Abort"'
    exit(0)
    end

if msgsel.COUNT = 0 then do
    msgsel.1 = curmsg.MSGNR; msgsel.COUNT = 1
    end

address(bbsread)
BUFMODE COPYBACK

do i = 1 to msgsel.COUNT
    drop data. head. text.

    address(bbsread)
    READBRMESSAGE '"'curmsg.BBSNAME'"' '"'curmsg.CONFNAME'"' '"'msgsel.i'"' TEXTSTEM text HEADSTEM head DATASTEM data
    if rc ~= 0 then do
        address(thorport)
        REQUESTNOTIFY '"READBRMESSAGE (message #'msgsel.i'):\n 'BBSREAD.LASTERROR'"' '"Abort"'
        signal cleanup
        end

    if text.TEXT.COUNT = 0 & (text.PART.COUNT = 0 | symbol('text.PART.COUNT') ~= 'VAR') then do
        address(thorport)
        REQUESTNOTIFY '"No message body (message #'msgsel.i').\nMessage not copied."' '"'_Ok'"'
        signal cleanup
        end

    text.replyconf = curmsg.CONFNAME

    if head.fromname        ~= "HEAD.FROMNAME"        then text.fromname        = head.fromname
    if head.fromaddr        ~= "HEAD.FROMADDR"        then text.fromaddr        = head.fromaddr
    if head.toname          ~= "HEAD.TONAME"          then text.toname          = head.toname
    if head.toaddr          ~= "HEAD.TOADDR"          then text.toaddr          = head.toaddr
    if head.msgid           ~= "HEAD.MSGID"           then text.msgid           = head.msgid
    if head.refid           ~= "HEAD.REFID"           then text.refid           = head.refid
    if head.creationdate    ~= "HEAD.CREATIONDATE"    then text.creationdate    = head.creationdate
    if head.creationdatetxt ~= "HEAD.CREATIONDATETXT" then text.creationdatetxt = head.creationdatetxt
    if head.subject         ~= "HEAD.SUBJECT"         then text.subject         = head.subject

    red = ""; priv = ""; urg = ""; imp = ""; conf = ""
    if bittst(data.flags, 0)  then red  = "READ"
    if bittst(data.flags, 2)  then priv = "PRIVATE"
    if bittst(data.flags, 11) then urg  = "URGENT"
    if bittst(data.flags, 12) then imp  = "IMPORTANT"
    if bittst(data.flags, 17) then conf = "CONFIDENTIAL"

    if nomarkmsg then nomark = 'DONTMARKMESSAGE'
    else nomark = ''

    WRITEBRMESSAGE '"'curmsg.BBSNAME'"' '"'toconf'"' STEM text nomark red priv urg imp conf
    if rc = 7 then do
        CONFIGCONF '"'curmsg.BBSNAME'"' '"'toconf'"' SET c2x(CDF_NOT_ON_BBS)
        WRITEBRMESSAGE '"'curmsg.BBSNAME'"' '"'toconf'"' STEM text nomark red priv urg imp conf
        if rc ~= 0 then do
            address(thorport)
            REQUESTNOTIFY '"WRITEBRMESSAGE:\n'BBSREAD.LASTERROR'"' '"_Ok"'
            signal cleanup
            end
        end
    else if rc ~= 0 then do
        address(thorport)
        REQUESTNOTIFY '"WRITEBRMESSAGE:\n'BBSREAD.LASTERROR'"' '"_Ok"'
        signal cleanup
        end

    mnr = result
    repl = ""
    if bittst(data.flags, 1) then repl = "SETREPLIED"

    if mnr = -1 then do
        REQUESTNOTIFY '"The message could not be written\nbecause it was caught by a kill entry."' '"_Ok"'
        signal cleanup
        end

    address(bbsread)
    UPDATEBRMESSAGE '"'curmsg.BBSNAME'"' '"'toconf'"' mnr SETKEEP repl HAZELEVEL data.HAZELEVEL
    if rc ~= 0 then do
        address(thorport)
        REQUESTNOTIFY '"UPDATEBRMESSAGE:\n'BBSREAD.LASTERROR'"' '"_Ok"'
        signal cleanup
        end
    end

address(thorport)
UPDATECONFWINDOW

signal cleanup

error:
halt:
break_c:

if rc ~= 0 then say '+++ Line 'sigl' returned 'rc': 'errortext(rc)

cleanup:

address(bbsread)
BUFMODE ENDCOPYBACK

exit(0)